(FILECREATED "12-OCT-73  6:10:22" TEST)


  (LISPXPRINT (QUOTE TESTVARS)
              T)
  [RPAQQ TESTVARS ((PROP MACRO FOREACH GENERATE USE)
          (FNS DWIMUSERFN TEST LISPXUSERFN)
          (VARS (DWIMUSERFN T))
          (VARS (TRAPCNT (TRAPCOUNT))
                (LISPXUSERFN T]
(DEFLIST(QUOTE(
  [FOREACH
    (X
      ([LAMBDA
         (VAR FORM DO)
         (LIST
           (QUOTE PROG)
           [LIST
             (LIST
               (QUOTE DOER)
               (LIST (QUOTE FUNCTION)
                     (LIST (QUOTE LAMBDA)
                           (LIST (QUOTE Y)
                                 (QUOTE POS))
                           (LIST (QUOTE STKEVAL)
                                 (LIST (QUOTE OR)
                                       (QUOTE POS)
                                       (LIST (QUOTE STKNTH)
                                             -1))
                                 (LIST (QUOTE LIST)
                                       (LIST (QUOTE FUNCTION)
                                             (LIST (QUOTE LAMBDA)
                                                   (LIST VAR)
                                                   DO))
                                       (QUOTE Y]
           (LIST (QUOTE MAPC)
                 FORM
                 (QUOTE DOER]
       (CAR X)
       (CADR X)
       (CADDR X]
  [GENERATE
    (X
      ([LAMBDA
         (TYPE FORM)
         (COND ((AND (NULL (CDR FORM))
                     (NLISTP FORM))
                (HELP "GENERATE ON AN ATOM" X)))
         (* WANT (GENERATE "FOO" X)
            TO JUST REBIND DOER; THEN USE WILL LOOKUP TYPE, AND IF IT 
            IS A BLIP, JUST ADD IT ON, AND IOTHERWISE, APPLY)
         (NCONC
           [LIST (QUOTE PROG)
                 (LIST (LIST TYPE (LIST (QUOTE OR)
                                        (QUOTE DOER)
                                        (LIST (QUOTE CONS)
                                              (LIST (QUOTE QUOTE)
                                                    (QUOTE BLIP]
           (APPEND
             FORM
             (LIST (LIST (QUOTE RETURN)
                         (LIST (QUOTE COND)
                               (LIST (LIST (QUOTE EQ)
                                           (LIST (QUOTE CAR)
                                                 TYPE)
                                           (LIST (QUOTE QUOTE)
                                                 (QUOTE BLIP)))
                                     (LIST (QUOTE CDR)
                                           TYPE))
                               (LIST T NIL]
       (CAR X)
       (CDR X]
  [USE
    (Z
      ([LAMBDA
         (TYPE X)
         (LIST [LIST (QUOTE LAMBDA)
                     (QUOTE (X))
                     (LIST (QUOTE COND)
                           [LIST (LIST (QUOTE EQ)
                                       (LIST (QUOTE CAR)
                                             TYPE)
                                       (LIST (QUOTE QUOTE)
                                             (QUOTE BLIP)))
                                 (LIST (QUOTE RPLACD)
                                       TYPE
                                       (LIST (QUOTE CONS)
                                             (QUOTE X)
                                             (LIST (QUOTE CDR)
                                                   TYPE]
                           (LIST T (LIST (QUOTE APPLY*)
                                         (LIST (QUOTE CAR)
                                               TYPE)
                                         (QUOTE X)
                                         (LIST (QUOTE CDR)
                                               TYPE]
               X]
       (CAR Z)
       (CADR Z]
))(QUOTE MACRO))

(DEFINEQ

(DWIMUSERFN
  [LAMBDA NIL
    (AND (NOT FAULTAPPLYFLG)
         (LISTP FAULTX)
         (LITATOM (CAR FAULTX))
         (NOT (FGETD (CAR FAULTX)))
         (PROG [(MACVAL (GETP (CAR FAULTX)
                              (QUOTE MACRO]
               (AND MACVAL (NOT (EDITFINDP MACVAL (QUOTE ASSEMBLE)))
                    [CLISPTRAN FAULTX
                               (COND
                                 ((FMEMB (CAR MACVAL)
                                         (QUOTE [LAMBDA NLAMBDA]))
                                   (CONS MACVAL (CDR FAULTX)))
                                 [(AND (CAR MACVAL)
                                       (ATOM (CAR MACVAL)))
                                   (EVALA (CADR MACVAL)
                                          (LIST (CONS (CAR MACVAL)
                                                      (CDR FAULTX]
                                 (T (SUBPAIR (CAR MACVAL)
                                             (CDR FAULTX)
                                             (CADR MACVAL]
                    (RETURN FAULTX])

(TEST
  [LAMBDA (X)
    (GENERATE TEST (FOR X IN (QUOTE (A B C)) DO (USE TEST X])

(LISPXUSERFN
  [LAMBDA (X)
    (SETQ X (TRAPCOUNT))
    (COND
      ((NEQ X TRAPCNT)
        (LISPXPRIN1 (IDIFFERENCE X TRAPCNT)
                    T)
        (LISPXPRIN1 (QUOTE " TRAPS IN PREVIOUS EVENT.
")
                    T)))
    (SETQ TRAPCNT X)
    NIL])
)
  (RPAQ DWIMUSERFN T)
  (RPAQ TRAPCNT (TRAPCOUNT))
  (RPAQ LISPXUSERFN T)
STOP